(defpackage :draw-tree-mixin
  (:use :cl :boxes.util :diagram)
  (:nicknames :dtm)
  (:export :draw-tree-mixin
           :draw-argument-background
           :draw-argument-arrows))

(in-package :draw-tree-mixin)

(defclass draw-tree-mixin (diagram-view)
  ())

(defgeneric draw-arrow-to (node child view))

(defmethod draw-node :before ((node box) (view draw-tree-mixin))
  (multiple-value-bind (x y) (gwee:translate-coordinates (geom:x node) (geom:y node) view)
    (sdl:draw-box-* x y (geom:width node) (geom:height node) :color (gwee:gray 250))
    (sdl:draw-rectangle-* x y (geom:width node) (geom:height node) :color (gwee:gray 0))
    (when (highlighted node)
      (sdl:draw-rectangle-* (1- x) (1- y) (+ (geom:width node) 2) (+ (geom:height node) 2) :color (if (selected node)
                                                                                                      (selected-color view)
                                                                                                      (gwee:gray 0))))
    (when (selected node)
      (gwee:draw-rectangle-* view (geom:x node) (geom:y node) (geom:width node) (geom:height node) :color (selected-color view) :thickness 2))))

(defmethod draw-arrow-to (node child (view draw-tree-mixin))
  (let ((arrow-color (or (if (listp (arrow-color node))
                             (second (find child (arrow-color node) :key 'first))
                             (arrow-color node))
                         (arrow-color view))))
    (if (> (- (geom:y (tree:parent node)) (geom:bottom child))
           (* (vpadding view) 2))
        (progn
          (gwee:draw-line-* view (geom:centerx child)
                            (geom:bottom child)
                            (geom:centerx node)
                            (+ (geom:bottom child) (vpadding view))
                            :color arrow-color
                            :thickness (arrow-thickness view))
          (gwee:draw-filled-aa-circle (gwee::translate-x-coordinate (geom:centerx node) view)
                                      (+ (gwee::translate-y-coordinate (geom:bottom child) view) (vpadding view))
                                      (truncate (arrow-thickness view) 2)
                                      :color arrow-color)
          (gwee:draw-line-* view (geom:centerx node)
                            (+ (geom:bottom child) (vpadding view))
                            (geom:centerx node)
                            (geom:y node)
                            :color arrow-color
                            :thickness (arrow-thickness view) :style :arrow))
        (gwee:draw-line-* view (geom:centerx child)
                          (geom:bottom child)
                          (geom:centerx node)
                          (geom:y node)
                          :color arrow-color
                          :thickness (arrow-thickness view) :style :arrow))))

(defun draw-argument-background (node view)
  (gwee:draw-rectangle view (geom:x node) (geom:y node) (geom:width node) (geom:height node)
                       :color (background node) :filled t)
  (when (highlighted node)
    (gwee:draw-rectangle view (1- (geom:x node)) (1- (geom:y node))
                         (+ (geom:width node) 2) (+ (geom:height node) 2)
                         :color (if (selected node)
                                    (selected-color view)
                                    (highlight-color view))))
  (if (selected node)
      (gwee:draw-rectangle-* view (geom:x node) (geom:y node)
                             (geom:width node) (geom:height node)
                             :color (selected-color view)
                             :thickness 2)
      (gwee:draw-rectangle view (geom:x node) (geom:y node)
                           (geom:width node) (geom:height node)
                           :color (outline node))))

(defun draw-argument-arrows (node view)
  (dolist (i (tree:children node))
    (draw-arrow-to node i view)))

(defmethod draw-node ((node argument) (view draw-tree-mixin))
  (draw-argument-background node view)
  (when (quantity node)
    (gwee:draw-text view 
                    (if (stringp (quantity node))
                        (quantity node)
                        (prin1-to-string (quantity node)))
                    (center-inside (geom:width node)
                                   (text-width (quantity node) (gwee:view-font view))
                                   (geom:x node))
                    (center-inside (geom:height node)
                                   (sdl:get-font-height :font (gwee:view-font view))
                                   (geom:y node))
                    :color (foreground node)
                    :font (gwee:view-font view)))
  (draw-argument-arrows node view))

(defmethod draw-node ((node invisible-argument) (view draw-tree-mixin))
  ;; they're like invisible, man.
  )

;; (defmethod draw-node ((node operator-box) (view draw-tree-mixin))
;;   )

(defmethod draw-node ((node multi-argument-box) (view draw-tree-mixin))
  )

(defmethod draw-node :around ((node invisible-box) (view draw-tree-mixin))
  ;; they're like invisible, man.
  )

;; (defmethod draw-node ((node single-box) (view draw-tree-mixin))
;;   )

(defmethod draw-node :after ((node interactive-mixin) (view draw-tree-mixin))
  (when *debug*
    (let ((font (gwee:open-font gwee:*default-font-name* 12)))
      (when (debug-text node)
        (multiple-value-bind (x y) (gwee:translate-coordinates (geom:x node) (geom:y node) view)
          (declare (ignore x))
          (let ((s (if (stringp (debug-text node))
                       (debug-text node)
                       (prin1-to-string (debug-text node)))))
            (sdl:draw-string-blended-* s
                                       (geom:centerx node) (- y (sdl:get-font-height :font font))
                                       :color (gwee:color 255 0 0)
                                       :font font)))))))

(defun draw-arrow (x y &key
                   (direction :right)
                   (arrow-height 25)
                   (tail-length 40)
                   (arrow-width 20)
                   (tail-height 10)
                   (color (sdl:color :r 255 :g 0 :b 0)))
  (let* ((dir (ecase direction (:right 1) (:left -1)))
         (points (list
                  (sdl:point :x x :y y)
                  (sdl:point :x (- x (* dir arrow-width)) :y (- y (* dir (truncate arrow-height 2))))
                  (sdl:point :x (- x (* dir (- arrow-width 3))) :y (- y (* dir (truncate tail-height 2))))
                  (sdl:point :x (- x (* dir (+ tail-length arrow-width))) :y (- y (* dir (truncate tail-height 2))))
                  (sdl:point :x (- x (* dir (+ tail-length arrow-width))) :y (+ y (* dir (truncate tail-height 2))))
                  (sdl:point :x (- x (* dir (- arrow-width 3))) :y (+ y (* dir (truncate tail-height 2))))
                  (sdl:point :x (- x (* dir arrow-width)) :y (+ y (* dir (truncate arrow-height 2)))))))
    (sdl:draw-filled-polygon points :color color)
    (sdl:draw-aa-polygon points :color color)))

(defmethod draw-node-arrow ((node box) (view draw-tree-mixin))
  (when (arrow node)
    (let ((x (gwee:view-to-top-x view (geom:x node)))
          (y (gwee:view-to-top-y view (geom:centery node)))
          (dir (if (find-if-on-tree (lambda (b) (geom:insidep b (- (geom:centerx node) 100) (geom:centery node)))
                                      (root view))
                   :left :right)))
      (draw-arrow (if (eq dir :left)
                      (+ x (geom:width node))
                      (1- x))
                  y
                  :direction dir
                  :color (if (typep (arrow node) 'sdl:color)
                             (arrow node)
                             (node-arrow-color view))))))

(defmethod best-arrow-direction ((node argument) (view draw-tree-mixin))
  (labels ((only-child-p (node)
             (eql (length (tree:children (tree:parent node))) 1))
           (left-most-p (node)
             (eql node (first (tree:children (tree:parent node)))))
           (right-most-p (node)
             (eql node (car (last (tree:children (tree:parent node))))))
           (left-of (node)
             (cadr (member node (reverse (tree:children (tree:parent node))))))
           (inputs-to-the-left-p (node)
             (find-if (lambda (n) (typep n 'input-argument))
                      (cdr (member node (reverse (tree:children (tree:parent node)))))))
           (inputs-to-the-right-p (node)
             (find-if (lambda (n) (typep n 'input-argument))
                      (cdr (member node (tree:children (tree:parent node))))))
           (inputs-in-box (box)
             (find-if (lambda (n) (typep n 'input-argument))
                      (tree:children box)))
           (overlaps-box-with-inputs (node dir)
             (find-if-on-tree (lambda (b)
                                  (and (geom:insidep b (ecase dir
                                                         (:right (- (geom:x node) 50))
                                                         (:left (+ (geom:right node) 50)))
                                                     (geom:centery node))
                                       (u:neq b (tree:parent node))
                                       (inputs-in-box b)))
                                (root view)
                                :only-boxes t)))
    (cond
      ((only-child-p node)
       :right)
      ((left-most-p node)
       (cond
         ((inputs-to-the-right-p node)
          :right)
         ((overlaps-box-with-inputs node :right)
          :left)
         (t :right)))
      ((right-most-p node)
       (cond
         ((inputs-to-the-left-p node)
          :left)
         ((overlaps-box-with-inputs node :left)
          :right)
         (t :left)))
      ((inputs-to-the-right-p node)
       :right)
      (t :left))))

(defmethod draw-node-arrow ((node argument) (view draw-tree-mixin))
  (when (arrow node)
    (let* ((dir (best-arrow-direction node view))
           (box-underneath (or (find-if-on-tree (lambda (b)
                                                    (geom:insidep b (if (eq dir :right)
                                                                        (- (geom:x node) 40)
                                                                        (+ (geom:right node) 40))
                                                                  (geom:centery node)))
                                                  (root view)
                                                  :only-boxes t)
                               (tree:parent node))))
      (draw-arrow (+ (gwee:view-to-top-x view (geom:x node))
                     (if (eq dir :right)
                         0
                         (geom:width node)))
                  (gwee:view-to-top-y view (geom:centery node))
                  :tail-length (max (if (eq dir :right)
                                        (- (geom:x node) (geom:x box-underneath))
                                        (- (geom:right box-underneath) (geom:right node)))
                                    40)
                  :direction dir
                  :color (if (typep (arrow node) 'sdl:color)
                             (arrow node)
                             (node-arrow-color view))))))

(defmethod update-diagram-view ((v draw-tree-mixin))
  (when (root v)
    (space-tree v)
    (center-root v)
    (with-slots (gravity guide) v
      (ecase gravity
        ((:top :north) (move-tree (root v)
                         (geom:x (root v))
                         (- (+ guide
                               (geom:y (tree-dimensions (root v))))
                            (geom:height (root v)))
                         t))
        ((:bottom :south) (move-tree (root v)
                            (geom:x (root v))
                            (- guide
                               (geom:height (root v)))
                            t))
        (:center)
        ((:right :east)
         (move-tree (root v)
                    (- (gwee:view-width v)
                       (- (geom:x (tree-dimensions (root v)))
                          (- (geom:x (root v))
                             (geom:x (tree-coordinates (root v)))))
                       2)
                    (geom:y (root v))
                    t))
        ((:left :west)
         (move-tree (root v)
                    (- (geom:x (root v))
                       (geom:x (tree-coordinates (root v)))
                       -2)
                    (geom:y (root v))
                    t))
        ;; TODO: implement the other gravity positoins
        ))))

(defmethod gwee:draw-view ((view draw-tree-mixin))
  (when (spacing-failed-p view)
    (multiple-value-bind (x y) (gwee:translate-coordinates 0 0 view)
      (sdl:draw-box-* x y (gwee:view-width view) (gwee:view-height view) :color (gwee:color 255 200 200))))
  (when (root view)
    (funcall-on-tree (lambda (x) (draw-node x view)) (root view))
    (funcall-on-tree (lambda (x) (draw-node-arrow x view)) (root view)))
  (call-next-method))
